home *** CD-ROM | disk | FTP | other *** search
- 4 DEFINT K,F,T,L,R,N
- 5 DIM K$(55)
- 6 DIM FLDN$(1,60),FTY(1,60),FL(1,60)
- 8 DIM NREC(17),FD(3),Z$(60),L(50),R(50),F$(17)
- 10 CH = 29
- 12 GOSUB 8000
- 15 GOSUB 13000
- 16 H = A
- 17 GOSUB 7000
- 19 DEFSTR Z
- 20 A = H
- 25 GOSUB 9000
- 30 FLG = 0
- 45 L = 0
- 50 FOR T = 1 TO NREC(A)
- 55 L = L + FL(1,T)
- 60 NEXT T
- 70 DEFINT T
- 90 GOSUB 11000
- 100 GOSUB 10000
- 400 REM ****** GET DATA FROM DISKS *******
- 403 PRINT FRE(0)
- 405 GOSUB 16000
- 420 FOR T = 1 TO 30000
- 429 IF T > MRN GOTO 26000
- 430 GET #1,T
- 433 FOR T1 = 1 TO KTH
- 435 N = FD(T1)
- 436 IF FTY(1,N) = 1 GOTO 500
- 438 IF T1 = 1 THEN X(T) = 0
- 439 X(T) = X(T)*1E+06
- 440 ON FTY(1,N) GOTO 500,550,600,650,650
- 500 LET X(T) = Z$(N)
- 510 GOTO 700
- 550 X(T) = CVI(Z$(N)) + X(T)
- 560 GOTO 700
- 600 X(T) = CVS(Z$(N)) + X(T)
- 610 GOTO 700
- 650 X(T) = CVD(Z$(N)) + X(T)
- 700 NEXT T1
- 705 T(T) = T
- 710 NEXT T
- 1200 LP = 1
- 1210 FLG = 0
- 2000 REM
- 2010 M = 5000
- 2020 GOSUB 30000
- 2110 GOSUB 2200
- 2120 GOSUB 30000
- 2130 GOTO 3000
- 2200 REM
- 2210 L(1) = 1
- 2220 R(1) = MAXR
- 2230 S = 1
- 2240 IF (L(S)) < R(S) THEN 2270
- 2250 S = S - 1
- 2260 GOTO 2640
- 2270 I = L(S)
- 2280 J = R(S)
- 2290 P1= X(J)
- 2300 M = (I + J)/2
- 2310 IF (J - I<6) THEN 2400
- 2320 IF ((P1>X(I)) AND (P1<X(M))) THEN 2400
- 2330 IF ((P1<X(I)) AND (P1>X(M))) THEN 2400
- 2340 IF ((X(I)<X(M)) AND (X(I)>P1)) THEN 2380
- 2350 IF ((X(I)>X(M)) AND (X(I)<P1)) THEN 2380
- 2360 SWAP X(M),X(J)
- 2365 SWAP T(M),T(J)
- 2370 GOTO 2390
- 2380 SWAP X(I),X(J)
- 2385 SWAP T(I),T(J)
- 2390 P1 = X(J)
- 2400 WHILE (I<J)
- 2410 WHILE (X(I)< P1)
- 2420 I = I + 1
- 2430 WEND
- 2440 J=J-1
- 2450 WHILE (I<J)AND(P1<X(J))
- 2460 J = J-1
- 2470 WEND
- 2480 IF (I>=J) THEN 2510
- 2490 SWAP X(I),X(J)
- 2500 SWAP T(I),T(J)
- 2510 WEND
- 2520 J = R(S)
- 2530 SWAP X(I),X(J)
- 2540 SWAP T(I),T(J)
- 2550 IF (I - L(S)>=R(S)-I) THEN 2600
- 2560 L(S + 1) = L(S)
- 2570 R(S + 1) = I - 1
- 2580 L(S) = I + 1
- 2590 GOTO 2630
- 2600 L(S + 1) = I + 1
- 2610 R(S + 1) = R(S)
- 2620 R(S) = I - 1
- 2630 S = S + 1
- 2640 IF (S > 0) THEN 2240
- 2650 RETURN
- 3000 REM ******** PUT IN FILE ************
- 3100 GOSUB 9100
- 3110 Q$ = "B:"+F$(A)
- 3200 GOSUB 9200
- 3300 FOR Q = 1 TO MAXR
- 3310 RN = T(Q)
- 3312 GET #1,RN
- 3330 LSET Z1$ = Y$
- 3340 PUT #2,Q
- 3350 NEXT Q
- 3500 CLOSE
- 3600 GOSUB 15000
- 3620 PRINT "SORT FINISHED "
- 3630 END
- 7000 GOSUB 12000
- 7005 OPEN "I",#1,"FFILE"
- 7010 INPUT #1,MAXF
- 7020 FOR A = 1 TO MAXF
- 7030 INPUT #1,A,F$(A),NREC(A),L(A)
- 7040 FOR N = 1 TO NREC(A)
- 7050 INPUT #1,FLDN$(1,N),FTY(1,N),FL(1,N)
- 7055 IF FTY(1,N) = 2 THEN INPUT #1,KY,KEYLIST
- 7060 NEXT N
- 7065 IF A = AHLD THEN RETURN
- 7070 NEXT A
- 7080 CLOSE #1
- 7100 RETURN
- 8000 GOSUB 12000
- 8005 OPEN "I",#1,"FFILE"
- 8010 INPUT #1,MAXF
- 8020 FOR A = 1 TO MAXF
- 8030 INPUT #1,A,F$(A),NREC(A),L(A)
- 8040 FOR N = 1 TO NREC(A)
- 8050 INPUT #1,FLDN$(1,N),FTY(1,N),FL(1,N)
- 8055 IF FTY(1,N) = 2 THEN INPUT #1,KY,KEYLIST
- 8060 NEXT N
- 8070 NEXT A
- 8080 CLOSE #1
- 8100 RETURN
- 9000 REM ******* OPEN FILE SUBROUTINE *******
- 9010 CLOSE #1
- 9020 OPEN "R",#1,F$(A),L(A)
- 9030 D = 0
- 9040 FOR T = 1 TO NREC(A)
- 9050 FIELD #1,D AS D$,FL(1,T) AS Z$(T)
- 9060 D = D + FL(1,T)
- 9070 NEXT T
- 9080 RETURN
- 9100 REM ******* OPEN FILE SUBROUTINE *******
- 9110 CLOSE #1
- 9120 OPEN "R",#1,F$(A),L
- 9140 PRINT " L(A) ";L
- 9150 FIELD #1,L AS Y$
- 9180 RETURN
- 9200 REM ******* OPEN FILE SUBROUTINE *******
- 9210 CLOSE #2
- 9220 OPEN "R",#2,Q$,L
- 9250 FIELD #2,L AS Z1$
- 9280 RETURN
- 10000 REM ******* INITAL SELECTION ********
- 10010 GOSUB 15000
- 10100 PRINT "************** SORT FILE PROGRAM **************"
- 10105 PRINT "FILE NUMBER = ";A;" FILE NAME = ";F$(A)
- 10110 PRINT ""
- 10120 FOR T = 1 TO NREC(A)
- 10130 PRINT T;"- ";FLDN$(1,T)
- 10140 NEXT T
- 10150 PRINT ""
- 10160 PRINT "*** HOW MANY FIELDS DO YOU WANT TO SORT BY ? ***"
- 10170 PRINT "************** ENTER 1,2, OR 3 ***************"
- 10180 GOSUB 60000
- 10185 IF DT#<1 OR DT#>3 GOTO 10180
- 10190 KTH= DT#
- 10200 PRINT "*** WHICH FIELD IS THE PRIMARY SORT FIELD ? ***"
- 10210 GOSUB 60000
- 10212 IF DT#<1 OR DT#>NREC(A) GOTO 10210
- 10215 T3 = FD(1)
- 10218 FD(1) = DT#
- 10219 T3 = DT#
- 10220 IF KTH= 1 GOTO 10275
- 10230 PRINT "*********** WHICH FIELD IS THE SECONDARY FIELD ? **********"
- 10232 PRINT "- If the primary values are equal"
- 10234 PRINT "the record with the lowest secondary value will be stored first "
- 10240 GOSUB 60000
- 10242 IF DT#<1 OR DT#>NREC(A) GOTO 10240
- 10244 IF FTY(1,DT#) = 1 GOTO 10410
- 10246 FD(2) = DT#
- 10250 IF KTH= 2 GOTO 10275
- 10260 PRINT "************ WHICH FIELD IS THE THIRD FIELD ? *************"
- 10262 PRINT "- If both the primary value and the secondary value are equal"
- 10264 PRINT "the record with the lowest third value will be stored first"
- 10270 GOSUB 60000
- 10272 IF DT#<1 OR DT#>NREC(A) GOTO 10270
- 10273 IF FTY(1,DT#) = 1 GOTO 10410
- 10274 FD(3) = DT#
- 10275 ON FTY(1,T3) GOSUB 10400,10600,10500,10500,10500
- 10280 RETURN
- 10400 DEFSTR X,P
- 10410 IF KTH> 1 THEN PRINT "******** STRING VARIABLES MAY ONLY BE SORTED BY ONE FIELD ********"
- 10420 IF KTH> 1 GOTO 10100
- 10430 DIM X(3000),T(3000)
- 10490 RETURN
- 10500 DEFDBL X,P
- 10505 DIM X(3000),T(3000)
- 10510 RETURN
- 10600 IF KTH> 1 GOTO 10500
- 10610 DEFINT X,P
- 10620 DIM X(6000),T(6000)
- 10630 RETURN
- 11000 REM ******* INTRODUCTION ********
- 11100 GOSUB 15000
- 11110 PRINT "************************ SORT PROGRAM *************************"
- 11114 PRINT ""
- 11116 PRINT " Copyright 1984 by Potomac Pacific Engineering "
- 11120 PRINT ""
- 11130 PRINT "FILE NUMBER : ";A;" FILE NAME : ";F$(A)
- 11140 PRINT ""
- 11200 PRINT ""
- 11210 PRINT "Up to 6000 records may be sorted on ONE INTEGER FIELD "
- 11220 PRINT "Up to 3000 records may be sorted on ONE ALFANUMRIC FIELDS "
- 11230 PRINT "Up to 3000 records may be sorted on THREE DIFFERENT NUMERIC FIELDS"
- 11240 PRINT " Depending on what version of Basic you are using you may be able"
- 11250 PRINT "to increase the number of records you can sort by changing the "
- 11260 PRINT "DIM (dimension) statement in lines 10400 -10630. The compiled
- 11270 PRINT "Version can handle 10000,42000, and 42000 records respectfully."
- 11300 PRINT ""
- 11310 PRINT "The sort program reads the file on the default disk drive, sorts"
- 11320 PRINT "the records, then writes a sorted file with the same file name"
- 11330 PRINT "on a disk drive B. "
- 11940 PRINT ""
- 11950 PRINT "****************** PRESS ANY KEY TO CONTINUE ******************"
- 11960 IF INKEY$ = "" GOTO 11960
- 11970 RETURN
- 12000 REM *****
- 12005 GOSUB 15000
- 12010 PRINT " Put the DATA floppy disk in the default disk drive "
- 12020 PRINT ""
- 12030 PRINT " ****** PRESS ANY KEY TO CONTINUE ***** "
- 12040 IF INKEY$ = "" GOTO 12040
- 12050 RETURN
- 13000 REM *****
- 13100 GOSUB 15000
- 13110 PRINT "****************** SORT PROGRAM *******************"
- 13120 PRINT ""
- 13130 PRINT "********** WHICH FILE DO YOU WANT TO SORT *********"
- 13140 FOR T = 1 TO MAXF
- 13150 PRINT T;" - ";F$(T)
- 13160 NEXT T
- 13170 PRINT "***** ENTER THE FILE NUMBER THEN PRESS RETURN ******"
- 13180 GOSUB 60000
- 13185 IF DT#<1 OR DT# >MAXF GOTO 13180
- 13190 A = DT#
- 13195 AHLD = A
- 13200 RETURN
- 14000 REM ***** SORT SELECTION
- 14100 GOSUB 15000
- 14110 PRINT "******************* SORT PROGRAM ********************"
- 14120 PRINT ""
- 14130 PRINT "DO YOU WANT TO SORT A FILE ON :"
- 14140 PRINT ""
- 14150 PRINT " 1. ONLY ONE INTEGER FIELD"
- 14160 PRINT ""
- 14170 PRINT " 2. ONE TO THREE NUMERIC FIELDS "
- 14180 PRINT ""
- 14190 PRINT " 3. A STRING FIELD"
- 14200 PRINT ""
- 14300 PRINT "******* ENTER THE NUMBER THEN PRESS RETURN ********"
- 14400 GOSUB 60000
- 14410 T = DT#
- 14420 ON T GOTO 14500,14700,14900
- 14500 REM
- 14520 GOSUB 12000
- 14540 RUN "SORTINT"
- 14700 GOTO 10
- 14900 REM
- 14920 GOSUB 12000
- 14940 RUN "SORTSTR"
- 15000 REM ****** CLEAR SCREEN
- 15010 CLS
- 15020 RETURN
- 16000 REM ****** FIND MAX RECORD
- 16100 MRN = LOF(1)/L(A)
- 16200 RETURN
- 26000 REM ******* ON ERROR ROUTINE ************
- 26200 PRINT "END OF FILE"
- 26205 MAXR = T - 1
- 26206 PRINT MAXR," MAX RECORD "
- 26210 GOTO 1200
- 30000 FOR T = 1 TO MAXR
- 31000 PRINT X(T)
- 32000 NEXT T
- 33000 RETURN
- 60000 REM ******* INTEGER LESS THEN 100 CHECK ********
- 60010 MAX = 2
- 60020 ACT$ = "1234567890=<>^"
- 60030 IF NE = 0 THEN ACT$ = "1234567890"
- 60040 PRINT ">__<";
- 60050 GOTO 60240
- 60060 REM ******* INTEGER *******
- 60070 MAX = 8
- 60080 ACT$ = "1234567890-+,=<>^"
- 60090 IF NE = 0 THEN ACT$ = "1234567890-+,"
- 60100 PRINT ">________<";
- 60110 GOTO 60240
- 60120 REM ******* SINGLE PRECISION *******
- 60130 MAX = 10
- 60140 ACT$ = "1234567890-+,.%$=<>^"
- 60150 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
- 60160 PRINT ">__________<";
- 60170 GOTO 60240
- 60180 REM ******* DOUBLE PRECISION *******
- 60190 MAX = 20
- 60200 ACT$ = "1234567890-+,.%$=<>^"
- 60210 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
- 60220 PRINT ">____________________<";
- 60230 GOTO 60240
- 60240 REM ********** NUMBER CHECK **********
- 60250 A$ = ""
- 60260 K$(20) = " "
- 60270 KTMAX = 0
- 60280 FOR T9 = 1 TO MAX
- 60290 K$(T9) = " "
- 60300 NEXT T9
- 60310 DIG$ = "1234567890."
- 60320 DOTFLG = 0
- 60330 T2 = MAX + 1
- 60340 FOR T6 = 1 TO T2
- 60350 PRINT CHR$(CH);
- 60360 NEXT T6
- 60370 IF INKEY$ = "" GOTO 60380 ELSE GOTO 60370
- 60380 KT = 0
- 60390 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH ***********
- 60400 KT = KT + 1
- 60410 REM
- 60420 W$ = INKEY$
- 60430 IF W$ = "" GOTO 60420
- 60440 C = ASC(W$)
- 60450 IF C = 0 THEN GOSUB 61900
- 60460 IF C = 13 GOTO 60580
- 60470 IF C = 17 OR C = 8 GOTO 61150
- 60480 IF C = 19 GOTO 60670
- 60490 IF C = 4 GOTO 60720
- 60500 IF C = 6 GOTO 60780
- 60510 IF C = 1 GOTO 60960
- 60520 IF KT > MAX GOTO 60410
- 60530 IF INSTR(ACT$,W$) = 0 GOTO 61230
- 60540 K$(KT) = W$
- 60550 PRINT K$(KT);
- 60560 IF KT > KTMAX THEN KTMAX = KT
- 60570 GOTO 60400
- 60580 REM ********** RETURN **********
- 60590 FOR T9 = 1 TO KTMAX
- 60600 A$ = A$ + K$(T9)
- 60610 NEXT T9
- 60620 IF KTMAX = 0 THEN PRINT "1"
- 60630 IF KTMAX = 0 THEN DT# = 1
- 60640 IF KTMAX = 0 THEN RETURN
- 60650 PRINT ""
- 60660 GOTO 61260
- 60670 REM ********* MOVE CURSE BACK ********
- 60680 IF KT = 1 GOTO 60410
- 60690 KT = KT - 1
- 60700 PRINT CHR$(CH);
- 60710 GOTO 60410
- 60720 REM ********* MOVE CURSER FORWARD *********
- 60730 IF KT >= MAX GOTO 60410
- 60740 IF KT > (KTMAX + 1) GOTO 60410
- 60750 PRINT K$(KT);
- 60760 KT = KT + 1
- 60770 GOTO 60410
- 60780 REM ********** INSERT ***********
- 60790 IF KT > KTMAX GOTO 60410
- 60800 X9 = MAX
- 60810 WHILE X9 > KT
- 60820 X9 = X9 - 1
- 60830 K$(X9 + 1) = K$(X9)
- 60840 WEND
- 60850 K$(KT) = " "
- 60860 KTMAX = KTMAX + 1
- 60870 IF KTMAX > MAX THEN KTMAX = MAX
- 60880 FOR T9 = KT TO KTMAX
- 60890 PRINT K$(T9);
- 60900 NEXT T9
- 60910 T6 = (KTMAX - KT) + 1
- 60920 FOR T7 = 1 TO T6
- 60930 PRINT CHR$(CH);
- 60940 NEXT T7
- 60950 GOTO 60410
- 60960 REM ********** DELETE ***********
- 60970 IF KT > KTMAX GOTO 60410
- 60980 IF KTMAX = 1 GOTO 60410
- 60990 K$(MAX + 1) = ""
- 61000 X9 = KT
- 61010 WHILE X9 <= MAX
- 61020 K$(X9) = K$(X9 + 1)
- 61030 X9 = X9 + 1
- 61040 WEND
- 61050 KTMAX = KTMAX - 1
- 61060 FOR T9 = KT TO KTMAX
- 61070 PRINT K$(T9);
- 61080 NEXT T9
- 61090 PRINT "_";
- 61100 T7 = (KTMAX - KT) + 2
- 61110 FOR T8 = 1 TO T7
- 61120 PRINT CHR$(CH);
- 61130 NEXT T8
- 61140 GOTO 60410
- 61150 REM ********* BACKSPACE ********
- 61160 IF KT = 1 GOTO 60410
- 61170 KT = KT - 1
- 61180 PRINT CHR$(CH);
- 61190 K$(KT) = " "
- 61200 PRINT "_";
- 61210 PRINT CHR$(CH);
- 61220 GOTO 60410
- 61230 REM ******* INPUT NOT ACCEPTABLE ********
- 61240 PRINT CHR$(7);
- 61250 GOTO 60420
- 61260 REM ********* CLEAR STRINGS ********
- 61270 MAX = LEN(A$)
- 61280 D2$ = ""
- 61290 D1$ = ""
- 61300 DFLG = 0
- 61310 FOR Q93 = 1 TO MAX
- 61320 R$ = MID$(A$,Q93,1)
- 61330 IF INSTR(DIG$,R$) = 0 GOTO 61400
- 61340 IF R$ = "." OR DFLG = 1 GOTO 61380
- 61350 IF DFLG = 1 GOTO 61380
- 61360 D2$ = D2$ + R$
- 61370 GOTO 61400
- 61380 D1$ = D1$ + R$
- 61390 DFLG = 1
- 61400 NEXT Q93
- 61410 DA# = VAL(D2$)
- 61420 D1# = VAL(D1$)
- 61430 DT# = DA# + D1#
- 61440 IF K$(1) = "-" THEN DT# = -DT#
- 61450 RETURN
- 61900 REM ****** CHECK FOR ASC0
- 61910 S4$ = INKEY$
- 61920 C2 = ASC(S4$)
- 61930 IF C2 = 83 THEN C = 1
- 61940 IF C2 = 82 THEN C = 6
- 61950 IF C2 = 75 THEN C = 19
- 61960 IF C2 = 77 THEN C = 4
- 61970 RETURN
- IF C2 = 83